home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BMUG Revelations
/
BMUG Revelations.toast
/
Programming
/
Programming Languages
/
UCB Logo 3.0
/
CSLS
/
pour
< prev
next >
Wrap
Text File
|
1992-09-04
|
2KB
|
86 lines
TO BREADTH.DESCEND :NODELIST
BREADTH.DESCEND NEXTLEVEL :NODELIST
END
TO BREADTH.FIRST :NODE
BREADTH.DESCEND CHILDREN :NODE
END
TO CHILD :PATH :FROM :TO
LOCAL "NEWSTATE
IF EQUALP :FROM :TO [OUTPUT []]
IF EQUALP 0 ITEM 1+:FROM :PATH [OUTPUT []]
IF NOT EQUALP :TO 0 ~
[IF EQUALP (ITEM :TO BF :PATH) (ITEM :TO :SIZES) [OUTPUT []]]
MAKE "NEWSTATE (NEWSTATE BF :PATH :FROM :TO)
IF MEMBERP :GOAL :NEWSTATE ~
[WIN (FPUT LIST :FROM :TO FIRST :PATH) :NEWSTATE THROW "WON]
IF MEMBERP :NEWSTATE :OLDSTATES [OUTPUT []]
MAKE "OLDSTATES FPUT :NEWSTATE :OLDSTATES
OUTPUT (LIST FPUT (FPUT LIST :FROM :TO FIRST :PATH) :NEWSTATE)
END
TO CHILDLIST :PATH :FROM
IF :FROM < 0 [OP []]
OP SE (CHILDLIST :PATH :FROM-1) ~
(CHILDLIST1 :PATH :FROM (COUNT :SIZES))
END
TO CHILDLIST1 :PATH :FROM :TO
IF :TO < 0 [OP []]
OP SE (CHILDLIST1 :PATH :FROM :TO-1) (CHILD :PATH :FROM :TO)
END
TO CHILDREN :PATH
OUTPUT CHILDLIST :PATH (COUNT :SIZES)
END
TO EMPTY :LIST
IF EMPTYP :LIST [OUTPUT []]
OUTPUT FPUT 0 EMPTY BF :LIST
END
TO NEWSTATE :STATE :FROM :TO
IF EQUALP :TO 0 [OUTPUT REPLACE :STATE :FROM 0]
IF EQUALP :FROM 0 [OUTPUT REPLACE :STATE :TO (ITEM :TO :SIZES)]
IF ((ITEM :FROM :STATE) < ((ITEM :TO :SIZES)-(ITEM :TO :STATE))) ~
[OUTPUT REPLACE (REPLACE :STATE :FROM 0) :TO ~
(SUM ITEM :FROM :STATE ITEM :TO :STATE)]
OUTPUT REPLACE (REPLACE :STATE :TO (ITEM :TO :SIZES)) :FROM ~
((ITEM :FROM :STATE)-((ITEM :TO :SIZES)-(ITEM :TO :STATE)))
END
TO NEXTLEVEL :NODELIST
IF EMPTYP :NODELIST [OUTPUT []]
OP SE (CHILDREN FIRST :NODELIST) (NEXTLEVEL BF :NODELIST)
END
TO PFORM :BUCKET
IF EQUALP :BUCKET 0 [OUTPUT "RIVER]
OUTPUT ITEM :BUCKET :SIZES
END
TO POUR :SIZES :GOAL
LOCAL "OLDSTATES
MAKE "OLDSTATES (LIST EMPTY :SIZES)
CATCH "WON [BREADTH.FIRST FPUT [] EMPTY :SIZES]
END
TO REPLACE :LIST :INDEX :VALUE
IF EQUALP :INDEX 1 [OUTPUT FPUT :VALUE BF :LIST]
OUTPUT FPUT FIRST :LIST (REPLACE BF :LIST (:INDEX-1) :VALUE)
END
TO WIN :MOVES :STATE
WIN1 :MOVES
PRINT SE [FINAL QUANTITIES ARE] :STATE
END
TO WIN1 :MOVES
IF EMPTYP :MOVES [STOP]
PRINT (SE [POUR FROM] (PFORM FIRST LAST :MOVES) ~
[TO] (PFORM LAST LAST :MOVES))
WIN1 BL :MOVES
END